Over 1,000 Windows 95 Programs/Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso/1157/source/componen/dtrans.pas

Pascal/Delphi Source File | 1996-11-07 | 13.2 KB | 416 lines

unit Dtrans;

interface

{
  DelphiTranslator Component
  Allow you to translate all string properties at design (and run)time.

  Simply put it on your Form,
  set the property FileName to 'test.lng'
  change property Language to 2,
  modify e.g. the Form.Caption and
  change property Language back to 1 ...

  not public release V 0.2, Copyright Matthias Weingart 1996
  [e-mail]

  to do:
  renamed to TLanguageSwitcher, done :-)
  translate TStringLists
  language file location with project path or store in StringList?
  Message to other TLanguageSwitcher-Components to Update Language, recognize that not all forms are open
  special string component

}

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, TypInfo, DebugBox;

type
  TLanguageCount = 1..100;

  TTreatPropertyFunction = procedure ( Component: TComponent; PropInfo : PPropInfo;
                                       const PropName : string; ALanguage: TLanguageCount
                                      ) of object;

  TLanguageSwitcher = class(TComponent)
  private
    { Private-Deklarationen }
   FFileName : string;
   FMaxLanguageCount : TLanguageCount;
   List: TStringList;
   FLanguage : TLanguageCount;
  protected
    { Protected-Deklarationen }
    StartComponent: TComponent;
    LanguageIdx: TLanguageCount;
    TreatPropertyFunction: TTreatPropertyFunction;

   Procedure SetLanguage(ALanguage : TLanguageCount);
   Procedure SetMaxLanguageCount(AMaxLanguageCount : TLanguageCount);
   Procedure SetFileName(AFileName : String);

    procedure TreatPropertyGet( Component:TComponent;
                                   PropInfo : PPropInfo; const PropName : string; ALanguage: TLanguageCount );
    procedure TreatPropertySet( Component:TComponent;
                                   PropInfo : PPropInfo; const PropName : string; ALanguage: TLanguageCount );
    procedure TreatPropertyCreate( Component:TComponent;
                                   PropInfo : PPropInfo; const PropName : string; ALanguage: TLanguageCount );
    procedure TreatProperty( Component:TComponent; PropInfo : PPropInfo; Name : string );
    procedure IterateProperties( Component : TComponent; TypeKinds: TTypeKinds; Name: string );
    procedure IterateComponents( Component : TComponent; TypeKinds: TTypeKinds; Name: string);
    procedure PropertyCreate( aList: TStringList; Component: TComponent );
    procedure PropertySet( aList: TStringList; Component: TComponent; aLanguageIdx: TLanguageCount );
    procedure PropertyGet( aList: TStringList; Component: TComponent; aLanguageIdx: TLanguageCount );
    procedure ReadHeader;
    procedure ReadList;
    procedure WriteList;
    procedure LanguageChange( Old, New: TLanguageCount);
    procedure MaxLanguageCountChange( AMaxLanguageCount: TLanguageCount );
    procedure FileNameChange;

  public
    { Public-Deklarationen }
    constructor Create(AOwner: TComponent); override;

  published
    { Published-Deklarationen }
   Property Language : TLanguageCount Read FLanguage Write SetLanguage Default 1;
   Property MaxLanguageCount : TLanguageCount Read FMaxLanguageCount Write SetMaxLanguageCount Default 1;
   Property FileName : String Read FFileName Write SetFileName;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TLanguageSwitcher]);
end;

constructor TLanguageSwitcher.Create(AOwner: TComponent);
begin
    inherited Create( AOwner );
    StartComponent := GetParentForm(Self.Owner as TControl); { the form where it is }
    if StartComponent = nil then
       Application.MessageBox('No Parent Form!', 'TLanguageSwitcher', mb_OK );
    TreatPropertyFunction:=nil;
    FLanguage:=1;
    FMaxLanguageCount:=2;
    List:=nil;
end;

Procedure TLanguageSwitcher.SetLanguage(ALanguage : TLanguageCount);
var Old: TLanguageCount;
Begin
   If (ALanguage <= MaxLanguageCount) and (ALanguage>=Low(TLanguageCount)) Then
   Begin
         Old:= FLanguage;
         FLanguage := ALanguage;
         LanguageChange( Old, ALanguage );
   End;
End;

Procedure TLanguageSwitcher.SetMaxLanguageCount(AMaxLanguageCount : TLanguageCount);
Begin
   if AMaxLanguageCount = FMaxLanguageCount then exit;
   If AMaxLanguageCount < FMaxLanguageCount Then
   Begin
      if (Application.MessageBox('Reduzing the number of languages will delete other languages. Sure?',
                                 'Warning!', mb_OKCancel )
          <>IDOK) then
          exit;
   End;
   if (not (csLoading in ComponentState)) then
      MaxLanguageCountChange( AMaxLanguageCount );
End;


Procedure TLanguageSwitcher.SetFileName(AFileName : String);
Begin
   If AFileName <> FFileName Then
   Begin
         FFileName := AFileName;
         if FileExists( FFileName ) then
         begin {read file}
            if (not (csLoading in ComponentState)) then
               FileNameChange;
         end;
   End;
End;

procedure TLanguageSwitcher.TreatPropertyCreate( Component:TComponent;
                                                 PropInfo : PPropInfo; const PropName : string; ALanguage: TLanguageCount );
var
  i: TLanguageCount;
  SubList: TStringList;
begin
       SubList:=TStringList.Create;
       for i:=1 to MaxLanguageCount do
           SubList.Add( GetStrProp( Component, PropInfo ) );
       List.AddObject(PropName, SubList);
end;

procedure TLanguageSwitcher.TreatPropertyGet( Component:TComponent;
                                                 PropInfo : PPropInfo; const PropName : string; ALanguage: TLanguageCount );
var
  i: TLanguageCount;
  SubList: TStringList;
  idx: Integer;
begin { the stringproperty GETs the value from the list}
     if List.Find( PropName, idx ) then
     begin
        SubList:=TStringList( List.Objects[idx] );
        SetStrProp( Component, PropInfo, SubList.Strings[ ALanguage-1 ] );
     end;{ else warning}
end;

procedure TLanguageSwitcher.TreatPropertySet( Component:TComponent;
                                                 PropInfo : PPropInfo; const PropName : string; ALanguage: TLanguageCount );
var
  i: TLanguageCount;
  SubList: TStringList;
  idx: Integer;
begin { the value in the list ist SET from the StringProperty }
     if List.Find( PropName, idx ) then
     begin
        SubList:=TStringList( List.Objects[idx] );
        if ALanguage-1<SubList.Count then
           SubList.Strings[ ALanguage-1 ] := GetStrProp( Component, PropInfo )
        else {Language is new, add the actual selected values}
           SubList.Add(GetStrProp( Component, PropInfo ));
     end else {Property is new}
        TreatPropertyCreate( Component, PropInfo, PropName, ALanguage );
end;

procedure TLanguageSwitcher.TreatProperty( Component:TComponent; PropInfo : PPropInfo; Name : string );
var
  n:string;
  l:byte;
  PropName: string;
begin
  if PropInfo = nil then Exit;
  n:=PropInfo^.PropType^.Name;
  if (PropInfo^.PropType^.Kind = tkString) and
     (PropInfo^.PropType^.Name <> 'TComponentName') then
  begin
       l:=GetTypeData(PropInfo^.PropType)^.MaxLength;
       PropName:=Name+PropInfo^.Name+'['+IntToStr(l)+']';
       TreatPropertyFunction( Component, PropInfo, PropName, LanguageIdx );
  end;
  {handle Stringlist here, Liste in einzelne Strings zerpfluecken, ist tkClass}
end;

procedure TLanguageSwitcher.IterateProperties( Component : TComponent; TypeKinds: TTypeKinds; Name: string );
var
   j : Integer;
   FCount, FSize : integer;
   FList : PPropList;
begin
  FCount := GetPropList(Component.ClassInfo, TypeKinds, nil);
  FSize := FCount * SizeOf(Pointer);
  GetMem(FList, FSize);
  GetPropList(Component.ClassInfo, TypeKinds, FList);

  for j:=0 to FCount-1 do
  begin
    TreatProperty( Component, FList^[ j ], Name );
  end;
  FreeMem( FList, FSize );
end;

function GetComponentName(Component : TComponent): string;
begin
   Result:=Component.Name;
   if Result='' then
      Result:='('+Component.ClassName+')';
end;

procedure TLanguageSwitcher.IterateComponents( Component : TComponent; TypeKinds: TTypeKinds; Name: string);
var i:integer;
begin
     Name:=Name+GetComponentName(Component)+'.';
     IterateProperties( Component, TypeKinds, Name ); { properties of the form }
     for i:=0 to Component.ComponentCount-1 do
     begin { properties of the components at the form }
      if Component.Components[i].ClassName<>'TLanguageSwitcher' then
      begin
       IterateProperties( Component.Components[i], TypeKinds,
                          Name + GetComponentName(Component.Components[i])+'.');
      end;
     end;
end;

procedure TLanguageSwitcher.PropertyCreate( aList: TStringList; Component: TComponent );
begin
     TreatPropertyFunction:=TreatPropertyCreate;
     List:=aList;
     IterateComponents( Component, [tkString], '' );
end;

procedure TLanguageSwitcher.PropertySet( aList: TStringList; Component: TComponent; aLanguageIdx: TLanguageCount );
begin
     TreatPropertyFunction:=TreatPropertySet;
     List:=aList;
     LanguageIdx:=aLanguageIdx;
     IterateComponents( Component, [tkString], '' );
end;

procedure TLanguageSwitcher.PropertyGet( aList: TStringList; Component: TComponent; aLanguageIdx: TLanguageCount );
begin
     TreatPropertyFunction:=TreatPropertyGet;
     List:=aList;
     LanguageIdx:=aLanguageIdx;
     IterateComponents( Component, [tkString], '' );
end;

procedure WriteSList( var f: TextFile; List: TStringList; Nsub: Integer );
var i,k:integer;
    SubList: TStringList;
begin
     for i:=0 to List.Count-1 do
     begin
         WriteLn(f, List.Strings[i] );
         if List.Objects[i] is TStringList then
         begin
           SubList:= TStringList( List.Objects[i] );
           for k:=0 to Nsub-1 do
           begin
             if k<SubList.Count then
               WriteLn(f, Sublist.Strings[k] )
             else
               if SubList.Count>0 then
                  WriteLn(f, Sublist.Strings[0] )
               else
                  WriteLn(f, '' );
           end;
         end;
     end;
end;

procedure ReadSList( var f: TextFile; List: TStringList; Nsub: Integer );
var s: string;
    SubList: TStringList;
    k: integer;
begin
     while not EOF(f) do
     begin
         SubList:=TStringList.Create;
         ReadLn(f, s);
         List.AddObject(s, SubList);
         for k:=0 to Nsub-1 do
         begin
              ReadLn(f, s);
              SubList.Add(s);
         end;
     end;
end;

procedure TLanguageSwitcher.ReadHeader;
var
    f: TextFile;
    i1,i2: TLanguageCount;
begin
           AssignFile( f, FileName);
           Reset( f );
           Readln( f, i1, i2 ); {read header}
           FMaxLanguageCount:=i2; {do nothing!}
           FLanguage:=i1;
           CloseFile( f );
end;

procedure TLanguageSwitcher.ReadList;
var
    f: TextFile;
begin
     AssignFile( f, FileName);
     Reset( f );
     Readln( f ); {read header as dummy}
     ReadSList( f, List, MaxLanguageCount );
     CloseFile( f );
end;

procedure TLanguageSwitcher.WriteList;
var
    f: TextFile;
begin
     AssignFile( f, FileName);
     Rewrite( f );
     Writeln( f, Language, ' ',MaxLanguageCount );
     WriteSList( f, List, MaxLanguageCount );
     CloseFile( f );
end;

procedure TLanguageSwitcher.LanguageChange( Old, New: TLanguageCount);
begin
 if (Old<>New) then begin
  if (Filename<>'') then begin
     List:= TStringList.Create;
     List.Sorted:=True;
     List.Duplicates:=dupAccept;
     if FileExists( FileName ) then
     begin
          ReadList;
          PropertySet( List, StartComponent, Old ); {store old Values in file}
          PropertyGet( List, StartComponent, New ); {get new Values from file}
          WriteList;
     end else begin
         PropertyCreate( List, StartComponent );
         WriteList;
     end;
     List.Free; List:=nil;
  end;
 end;
end;

procedure TLanguageSwitcher.MaxLanguageCountChange( AMaxLanguageCount: TLanguageCount );
var
   Enlarge: boolean;
begin
  if (Filename<>'') then begin
     List:= TStringList.Create;
     List.Sorted:=True;
     List.Duplicates:=dupAccept;
     if FileExists( FileName ) then
     begin
          ReadList;
          PropertySet( List, StartComponent, Language ); {store old Values in file}
     end else begin
         PropertyCreate( List, StartComponent);
     end;
     {Change Count}
     Enlarge:=FMaxLanguageCount < AMaxLanguageCount;
     FMaxLanguageCount := AMaxLanguageCount;
     if Enlarge then
        PropertySet( List, StartComponent, MaxLanguageCount ); {create New Entries}
     WriteList;
     List.Free; List:=nil;
  end;
end;

procedure TLanguageSwitcher.FileNameChange;
begin
  if (Filename<>'') then begin
     List:= TStringList.Create;
     List.Sorted:=True;
     List.Duplicates:=dupAccept;
     if FileExists( FileName ) then
     begin
          ReadHeader; { get: Language and MaxLanguageCount }
          ReadList;
          PropertyGet( List, StartComponent, Language ); {get new Values from file}
          WriteList;
     end else begin
         PropertyCreate( List, StartComponent );
         WriteList;
     end;
     List.Free; List:=nil;
  end;
end;


end.